ARIMA SERVICIOS MENSUALES

Introducción

Se determina el modelo de servicios diarios entre el períodode 2019 hasta julio de 2024 con frecuencia mensual.

ruta_servicios <- "/cloud/project/df_serv_dif.xlsx"
excel_sheets(ruta_servicios)

## [1] "Sheet1"

servicios <- as.data.frame(read_xlsx(ruta_servicios, 
                                     sheet = "Sheet1", col_names = T))

## New names:
## " `` -> `...1`

colnames(servicios) <- c("","Indice", "Fecha", "Totales")
servicios <- select(servicios, c("Indice", "Fecha", "Totales"))
servicios$mes <- format(x = servicios$Fecha, format = c("%Y-%m"))

nrow(servicios)

## [1] 183

head(servicios)

##   Indice      Fecha    Totales     mes
## 1      1 2019-07-03 -1.0949284 2019-07
## 2      2 2019-07-11 -2.4210608 2019-07
## 3      3 2019-07-20  2.0561828 2019-07
## 4      4 2019-07-22  0.4443343 2019-07
## 5      5 2019-07-31  1.3214042 2019-07
## 6      6 2019-08-05 -3.9744676 2019-08

Agrupando por mes

servicios <- servicios %>%
  group_by(Fecha = as.character(mes)) %>%
  summarize(Ventas_Totales = sum(Totales), 
            .groups = "keep")
head(servicios)

## # A tibble: 6 × 2
## # Groups:   Fecha [6]
##   Fecha   Ventas_Totales
##   <chr>            <dbl>
## 1 2019-07         0.306 
## 2 2019-08        -1.44  
## 3 2019-09        -0.0466
## 4 2019-10        -2.70  
## 5 2019-11         2.50  
## 6 2019-12         0.511

nrow(servicios)

## [1] 55

Serie temporal

servicios_mes_ts <- ts(servicios$Ventas_Totales,start = 1, frequency = 1)
servicios_mes_xts <- as.xts(servicios_mes_ts, dateFormat = "POSIXct")

Visualizacion de la serie.

ts_plot(servicios_mes_ts, color = "darkgreen", Xtitle = "Fecha", 
        Ytitle = "Valores", 
        title = "Serie de servicios mensuales")

plot.xts(x = servicios_mes_xts, bg = "white", 
              col = "black", labels.col = "black", 
         main = "Serie de servicios mensuales")

Determinación de estacionalidad.

urca::ur.df(servicios_mes_ts)

## 
## ############################################################### 
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test # 
## ############################################################### 
## 
## The value of the test statistic is: -4.9202

El valor del estadístico de Dickey-Fuller es -4.9202. Este resultado, significativamente menor que el valor crítico, nos permite rechazar la hipótesis nula de que la serie tiene una raíz unitaria a un nivel de significancia del 5%. En consecuencia, se concluye que la serie de tiempo es estacionaria.

kpss.test(servicios_mes_ts)

## Warning in kpss.test(servicios_mes_ts): p-value greater than printed p-value

## 
##  KPSS Test for Level Stationarity
## 
## data:  servicios_mes_ts
## KPSS Level = 0.037601, Truncation lag parameter = 3, p-value = 0.1

KPSS Level = 0.037601, Truncation lag parameter = 3, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia convencional de 0.05, no se rechaza la hipótesis nula.

Determinación de ACF y PACF.

ggAcf(servicios_mes_ts, col = "red", lwd = 1, lag.max = 12)

ggPacf(servicios_mes_ts, col = "blue", lag.max = 12, lwd = 1)

División de la serie en entrenamiento y prueba.

div_mes_serv <- ts_split(servicios_mes_ts, 
                                 sample.out =
                           round(length(servicios_mes_ts)*0.2))

entrena_serv_mes <- div_mes_serv$train

prueba_serv_mes <- div_mes_serv$test

Modelo

modelo_arima_mes_serv <- auto.arima(entrena_serv_mes,
                                       stepwise = F, 
                                    stationary = T)
summary(modelo_arima_mes_serv)

## Series: entrena_serv_mes 
## ARIMA(1,0,0) with zero mean 
## 
## Coefficients:
##           ar1
##       -0.2623
## s.e.   0.1435
## 
## sigma^2 = 16.4:  log likelihood = -123.51
## AIC=251.01   AICc=251.31   BIC=254.58
## 
## Training set error measures:
##                      ME     RMSE      MAE      MPE     MAPE      MASE
## Training set 0.07377221 4.003758 2.770434 103.9453 113.5065 0.5176432
##                    ACF1
## Training set 0.03846146

# AIC=251.01   AICc=251.31   BIC=254.58
# ARIMA(1,0,0) with zero mean 

Residuales

checkresiduals(modelo_arima_mes_serv, col = "red") # p-value = 0.4597

## 
##  Ljung-Box test
## 
## data:  Residuals from ARIMA(1,0,0) with zero mean
## Q* = 7.7354, df = 8, p-value = 0.4597
## 
## Model df: 1.   Total lags used: 9

Pronóstico

pronostico_mes_serv <- forecast(modelo_arima_mes_serv, 
                                   h = length(prueba_serv_mes), 
                                   level = 0.95)

Gráficas de pronósticos

Evitando el cero absoluto

prueba_serv_mes <-  as.numeric(prueba_serv_mes)
prueba_serv_mes[prueba_serv_mes == 0] <- 1e-6

Medidas de exactitud.

accuracy(pronostico_mes_serv$mean, prueba_serv_mes)

##                  ME     RMSE      MAE      MPE     MAPE
## Test set -0.1882187 2.071384 1.682836 33836.29 57808.15

#                 ME    RMSE      MAE   MPE MAPE       
# Test set -0.1882189 2.071384 1.682836 33836.29  57808.15       

Medidas de exactitud a 6 meses.

accuracy(pronostico_mes_serv$mean[1:6], prueba_serv_mes[1:6])

##                 ME     RMSE      MAE      MPE     MAPE
## Test set -0.509276 1.810381 1.163069 61949.87 105898.3

#                 ME     RMSE      MAE  MPE MAPE       
# Test set -0.5092763 1.810381 1.163069 61949.87  105898.3     

Conclusiones

El modelo determinado tiene valores de exactitud muy altos o lejanos del valor ideal (cero), el mejor modelo para servicios mensuales es el RML el cual tiene mejores valores de exactitud.